home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 4 / Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso / cad / dent.lsp < prev    next >
Lisp/Scheme  |  1991-03-30  |  2KB  |  80 lines
  1. ;Function CPROP
  2. ;
  3. ;Called with a required argument, which must be a valid
  4. ;entity association list.
  5. ;
  6. ;Changes current LAYER, LINETYPE, THICKNESS, and COLOR settings
  7. ;to those contained within the entity association list
  8. ;supplied as an argument.
  9.  
  10. (defun cprop (elist)
  11.   (command "layer" "s" (cdr (assoc 8 elist)) "")
  12.   (if
  13.     (assoc 6 elist)
  14.     (command "linetype" "s" (cdr (assoc 6 elist)) "")
  15.     (command "linetype" "s" "bylayer" "")
  16.   )
  17.   (if
  18.     (assoc 39 elist)
  19.     (command "elev" 0 (cdr (assoc 39 elist)))
  20.     (command "elev" 0 0)
  21.   )
  22.   (if
  23.     (assoc 62 elist)
  24.     (command "color" (cdr (assoc 62 elist)))
  25.     (command "color" "bylayer")
  26.   )
  27. )
  28.  
  29. ;Function C:DENT  Draw ENTity
  30. ;
  31. ;For AutoCAD Release 10
  32. ;
  33. ;DENT prompts user to select an entity, and passes the
  34. ;entity association list of the selected entity to the
  35. ;function CPROP.  Upon return from CPROP, DENT issues
  36. ;an AutoCAD command to draw the same type of entity as
  37. ;the one selected.
  38. ;
  39. ;This function is not fully de-bugged, and I expect you to
  40. ;encounter some situations where you will want to implement
  41. ;changes to this code.  Please be my guest and modify this
  42. ;to your heart's content.  I refuse to honor any requests for
  43. ;feature changes or bug fixes to this code; you're on
  44. ;your own.  Have fun!
  45. ;
  46. ;Written by Brad Zehring
  47. ;Tuesday  March 21, 1989  7:45 pm  Sausalito, California
  48. ;
  49. ;Based on an idea from Creighton Hoke
  50.  
  51. (defun C:DENT (/ ename elist)
  52.   (setvar "cmdecho" 0)
  53.   (if
  54.     (setq ename (entsel))
  55.     (progn
  56.       (setq ename (car ename))
  57.       (setq elist (entget ename))
  58.       (cprop elist)
  59.       (setvar "cmdecho" 1)
  60.       (cond
  61.         ((eq "TEXT" (cdr (assoc 0 elist)))
  62.          (command "DTEXT" "Style" (cdr (assoc 7 elist))
  63.                           pause
  64.                           (cdr (assoc 40 elist))
  65.                           (/ (* 180 (cdr (assoc 50 elist))) pi)
  66.          )
  67.         )
  68.         ((eq "POLYLINE" (cdr (assoc 0 elist)))
  69.          (command "PLINE")
  70.         )
  71.         ((eq "INSERT" (cdr (assoc 0 elist)))
  72.          (command "INSERT" (cdr (assoc 2 elist)))
  73.         )
  74.         (t (command (cdr (assoc 0 elist))))
  75.       )
  76.     )
  77.   )
  78.   (prin1)
  79. )
  80.